home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Testing & Debugging / Virtual User tools / SPEC S&L v.1.0.1 / Libraries / TCS.Lib < prev    next >
Encoding:
Text File  |  1993-12-17  |  42.6 KB  |  1,091 lines  |  [TEXT/MPS ]
  1. #
  2. # ****************************************************************************
  3. #
  4. #    File Name:    TCS.Lib
  5. #
  6. #    Contains:    Library used for tracking and logging Test Case completion and success/failure.
  7. #
  8. #    Written by:    Kevin Avoy, Ken Landreth, Michael Leong, Gil Spencer et al
  9. #
  10. #    Copyright:    © 1993 by Apple Computer, Inc., all rights reserved.
  11. #
  12. # ****************************************************************************
  13. #            C h a n g e        H i s t o r y (most recent first):
  14. # ****************************************************************************
  15. #
  16. #        Vers      Date        Author        Description
  17. #        ----    --------    ------    ---------------------------------------------
  18. #    <1.1.11>    12/17/93    KTA        Some references to  gTestCaseLoggingMethod were not declaring
  19. #                                    the variable to be global.
  20. #     <1.1.10>    12/16/93    KTA        Changed the way we handle exception, changed gFileToolOutput to 
  21. #                                    gTestCaseLoggingMethod
  22. #     <1.1.9>    12/13/93    KTA        Added ClearStack() task, and changed the way we handle
  23. #                                    exceptions.
  24. #     <1.1.7>     12/3/93    KTA        ApplicationVerification() if gAppTitle = 'Unknown' turn gAppVerify off. 
  25. #     <1.1.6>     12/3/93    KTA        Logical and physical memory are now reported in bytes, also 
  26. #                                    added SystemArch.
  27. #     <1.1.5>     12/2/93    KTA        Removed isOff, IsOn, VirtualMemory, notAvail, etc
  28. #     <1.1.4>     12/2/93    KTA        Added SystemArchitecture to Suite header. Added
  29. #                                    gSuiteFooterHook, moved call to ApplicationVerification() so it
  30. #                                    would be called when gDBLogging is off, Added gTCSStartHook1.
  31. #     <1.1.3>    11/24/93    NAGA        change "TCS [" to "TEST CASE ["
  32. #     <1.1.2>    11/24/93    NAGA        In LogTCSRecord() change TCSDescription to TCDesc
  33. #    1.0.119>     9/30/93    KTA        TCSEnd() -  pTCSVal no longer defaults to 'NA' and all fields
  34. #                                    which exist will printed in gNoteBook = 2.
  35. #    1.0.118>     9/30/93    KTA        PrintTCSRecord() - Fixed a bug where pTCSVal wouldn't print if
  36. #                                    is was an integer.
  37. #    1.0.117>     9/23/93    KTA        Moved gPreFlight to InitGlobals() and deleted gLaunchReqs, also
  38. #                                    fixed problem where ApplicationVerification() wasn't working.
  39. #    1.0.116>     9/23/93    KTA        LogSuiteHeader() - Commented out Desc field.
  40. #    1.0.115>     9/22/93    KTA        Call the gExceptionHandler task reference instead of calling the
  41. #                                    task directly.
  42. #    1.0.114>     9/20/93    KTA        ApplicationVerification() - Retry counter was decremented and it
  43. #                                    should have been incremented.
  44. #    1.0.113>     9/14/93    KTA        WriteTCSRecord() - If trouble with Filetool turn off
  45. #                                    FileToolOutput.        ApplicationVerification() -If gAppTitle
  46. #                                    is not defined turn off Application Verification
  47. #    1.0.112>     9/13/93    KTA        ExceptionHandler() - changed TimeOut values,
  48. #                                    ApplicationVerification() - intl - regular expressions errors.
  49. #    1.0.111>     9/13/93    KTA        Updated TestLevel specification.
  50. #    1.0.110>      9/2/93    KTA        Not writing to string 'FileTool output' to prefs file anymore.
  51. #    <1.0.19>      9/1/93    KTA        Changed all calls to VU built in task Exit to call the task
  52. #                                    reference gExitVu instead.
  53. #    <1.0.18>      9/1/93    KTA        Updated task headers and parameters.
  54. #    <1.0.17>     8/25/93    KTA        Added support for parity checking the TCS stack.
  55. #    <1.0.16>     8/23/93    KTA        Realigned fields in output, fixed TCSPassed.
  56. #    <1.0.15>     8/20/93    KTA        TCSStart() - If TCSAttempted is undefined call InitTCSLogging().
  57. #    <1.0.14>     8/20/93    KTA        Changed the return for ReadLine2, so had to update how the
  58. #                                    returnvalue was being used.
  59. #    <1.0.13>     8/20/93    KTA        Added LogSuiteHeader(), LogTCSRecord(), InitTCSLogging(), to
  60. #                                    support FileTool output of Phoenix data.
  61. #    <1.0.12>      8/9/93    KTA        Support for new Pheonix data format.
  62. #    <1.0.11>      8/2/93    KTA        CleanAbort() - Removed gExitFlag.
  63. #    <1.0.10>      8/2/93    KTA        CleanAbort() - Added gExitFlag.
  64. #     <1.0.9>     7/30/93    KTA        TCSEnd() - Changed DialogHandler() call and  added gTCSEndHook1.
  65. #     <1.0.8>     7/20/93    KTA        Bug Fix: failreason was being reinitialized improperly. See
  66. #                                    TCSEnd().
  67. #     <1.0.7>     7/15/93    KTA        Added TCSExpCount: See SuiteEnd()
  68. #     <1.0.6>      7/6/93    KTA        If gDBLogging is not set TCSEnd will not do anything.
  69. #     <1.0.5>      6/8/93    NAGA        unmark tasks that are not published
  70. #     <1.0.4>     5/21/93    NAGA        Adding header and porting old files to follow new standards
  71. #
  72. # ****************************************************************************
  73. #
  74.  
  75. ########################################################################
  76. #                            External libraries 
  77. #=======================================================================
  78. Libraries "Utility.lib","Gestalt.Lib","UserInterface.Lib", "FileTool.Lib", "String.Lib", "OutPut.Lib";
  79.  
  80.  
  81.  
  82. #########################################################################
  83. #                    InitTCSLogging(pSetupFileToolOutput)
  84. #========================================================================
  85. # Author:        Kevin Avoy (x4-5604)
  86. # Description:    Initializes globals and <Constants> necessary for generating
  87. #                database records known as TCS (Test Case Specification) records.
  88. # Parameters:    pSetupFileToolOutput - Boolean flag which indicates whether or not
  89. #                                    to set up the output file for logging TCS output.
  90. #                                    This requires the FileTool to exist on the Host.
  91. # Returns:        Nothing
  92. # Examples:        InitTCSLogging(0);
  93. # Assumptions:    None 
  94. #========================================================================
  95. # History:
  96. #
  97. #########################################################################
  98. TASK InitTCSLogging(pSetupFileToolOutput := 0)
  99. begin
  100.     if(pSetupFileToolOutput)
  101.         SetUpOutput(1);                                
  102.     
  103.     global gTCSList                := {};            # TCS Stack
  104.     global gExceptionHandler    := task ExceptionHandler;
  105.     global gExHandling             := 1;
  106.     global gDialogHandling         := 1;
  107.  
  108.     ############## TCS Globals ############
  109.     global kTCSetDefault := "UnknownSet";
  110.     global kTCTypeDefault := "Compatibility";
  111.     global kTCOwnerDefault := "SPECS&L";
  112.     global kTCSetLaunch := "Launch";
  113.     global kTCSetQuit := "Quit";
  114.     global kTCSetSFSave := "SFSave";
  115.     global kTCSetRevertDoc := "RevertDoc";
  116.     global kTCSetOpenDoc := "OpenDoc";
  117.     global kTCSetNewDoc := "NewDoc";
  118.     global kTCSetScrapBook := "ScrapBook";
  119.     global kTCSetFont := "Font";
  120.     global kTCSetPageSetup := "PageSetup";
  121.     global kTCSetUIWindowDrag := "UIWindowDrag";
  122.     global kTCSetUIWindowClose := "UIWindowClose";
  123.     global kTCSetUIWindowScroll := "UIWindowScroll";
  124.     global kTCSetUIWindowSize := "UIWindowSize";
  125.     global kTCSetUIWindowMiscOp := "UIWindowMiscOp";
  126.     global kTCSetAboutBox := "AboutBox";
  127.     global kTCSetAppSetup := "AppSetup";
  128.     global kTCSetDraw := "Draw";
  129.     global kTCSetPalettePicker := "PalettePicker";
  130.     global kTCSetToolPalette := "ToolPalette";
  131.  
  132.     global TCSAttempted := 0;
  133.     global TCSPassed    := 0;
  134.     global TCSNotAvail    := 0;
  135.     global TCSExpCount    := 0;
  136. end;
  137.  
  138.  
  139. #########################################################################
  140. #                        SetUpOutput(pCreateFiles)
  141. #========================================================================
  142. # Author:        Kevin Avoy
  143. # Description:    Sets up the files required to log TCS records using the FileTool.
  144. #                This will only occur if the Global gFileTooOutput evaluates
  145. #                to true.  This 1st attempt at setting up the output files is to
  146. #                read the 'SPEC S&L Prefs' file from the host Preferences folder.
  147. #                If this file does not exist or contain the proper info, a Folder
  148. #                will be created (if it does not already exist) on the root of 
  149. #                the boot drive titled "TCSOutput".  OutPut files will be created 
  150. #                in the folder which are titled with the name of the target
  151. #                and a time stamp. e.g. IIx.1235
  152. # Parameters:    pCreateFiles - Boolean Flag which indicates whether or not
  153. #                                to actually create the output files.
  154. # Returns:        Nothing
  155. # Examples:        SetUpOutput(1);
  156. # Assumptions:    Note: Two files are actually created/used.  1 main file and a 
  157. #                        'Temp' file.  TCS records are written to the 'Temp'
  158. #                        file and at the end of the run (SuiteEnd()) the 'Temp'
  159. #                        file is appended to the end of the main file and the 
  160. #                        'Temp' file is deleted.  If the user aborts a test, their
  161. #                        partial data will be in the 'Temp' file and the main
  162. #                        file will not be altered.
  163. #========================================================================
  164. # History:
  165. # KTA    12/1/93        Not writing total TestCase info to notebooks.
  166. #########################################################################
  167. task SetUpOutput(pCreateFiles := 0)
  168. begin
  169.     if(global gTestCaseLoggingMethod = 1)    # User wants to output TCS records using the FileTool
  170.     begin
  171.         DidFileToolInit := InitFileTool(false);        # FileTool Initialized properly
  172.         if not (DidFileToolInit)
  173.         begin
  174.             println "Problem initializing FileTool";
  175.             println "WARNING: We cannot write Test Case records using FileTool";
  176.         end;
  177.         else
  178.         begin
  179.             ## Prefs file - need to read Path and RunID
  180.             PrefsFolder := FindFolder("pref")[2];
  181.     
  182.             global SLPrefsFile := "{PrefsFolder}SPEC S&L Prefs:SPEC S&L Preferences";
  183.             isPrefs := FileExists( SLPrefsFile );
  184.     
  185.             if(isPrefs[2] = 1)
  186.             begin
  187.                 ## Read Path and RunID from Prefs File
  188.                 theLine := ReadLine2( SLPrefsFile, 0);        # First line of Prefs contains Path
  189.                 if(theLine)
  190.                 begin
  191.                     global gTCSOutputPath := StripCarriageReturn(theLine);
  192.         
  193.                     if(gTCSOutputPath)
  194.                         y := card(gTCSOutputPath);
  195.                     
  196.                     theLine2 := ReadLine2( SLPrefsFile ,y+1); # Second line of Prefs contains RunId 
  197.                     if(theLine2)
  198.                     begin
  199.                         RunID := StripCarriageReturn(theLine2);
  200.                     
  201.                         global gFileToolOutputFile := "{gTCSOutputPath}{global gMachineName}.{RunId}.TCS";
  202.                         global gFileToolOutputTempFile := "{gTCSOutputPath}{global gMachineName}.{RunId}.temp";
  203.                         fileToolFlag := 1;
  204.                     end;
  205.                 end;
  206.             end;
  207.             else
  208.                 LogStr("The 'SPEC S&L Prefs' file does not exist");
  209.     
  210.         
  211.             ## If couldn't read Prefs file correctly, set new outputFile based on:
  212.             ##    MachineName and Time of Day
  213.             if not ( fileToolFlag )    # In case something failed above, write to a unique file on root of boot
  214.             begin
  215.                 match[time h:?TheHour];
  216.                 SysFolderReturn := FindFolder("macs")[2];                # Get System folder path
  217.                 bootVol := StringUntilChar(SysFolderReturn, ':', 1);    # Strip so only has boot vol
  218.                 global gTCSOutputPath := "{bootVol}TCSOutput:";
  219.                 IsOutput := FileExists(gTCSOutputPath);
  220.                 if((IsOutput[1] <> 0)  and (IsOutput[2] <> 1))
  221.                     CreateFolder(gTCSOutputPath);
  222.                 else begin
  223.                     #println "The output Folder '{gTCSOutputPath}' already exists";
  224.                 end;
  225.                     
  226.                 global gFileToolOutputFile := "{gTCSOutputPath}{global gMachineName}.{TheHour}.TCS";
  227.                 global gFileToolOutputTempFile := "{gTCSOutputPath}{global gMachineName}.{TheHour}.temp";
  228.             end;
  229.         
  230.             if(pCreateFiles)        # Do we want to actually create the output folder/files
  231.             begin
  232.                 # Create a main file for all targets all suites, and a Temp to write individual suite Data, before catenation
  233.                 if (ExistsOrCreate( global gFileToolOutputFile ))
  234.                 begin
  235.                     TempFile := ExistsOrCreate( global gFileToolOutputTempFile );
  236.                     if( TempFile)    # Could we enable the file to exist
  237.                     begin
  238.                         if( TempFile = 1)    # File already Existed
  239.                             EraseFile( global gFileToolOutputTempFile );
  240.                     end;
  241.                     else
  242.                     begin
  243.                         Println "Error : Temp file does not exist - turning FileTool Logging - OFF";
  244.                         global gTestCaseLoggingMethod := 0;        # Turn test case logging - OFF
  245.                     end;
  246.                 end;
  247.                 else
  248.                 begin
  249.                     Println "Error : Output file does not exist - turning FileTool Logging - OFF";
  250.                     global gTestCaseLoggingMethod := 0;        # Turn test case logging - OFF
  251.                 end;
  252.             end;
  253.         end;
  254.     end;
  255. end;
  256.  
  257. #########################################################################
  258. #                            FillTCSId( pTCSId )
  259. #========================================================================
  260. # Author:        naga
  261. # Description:    Start TCS Record.
  262. # Parameters:    pTCSId
  263. # Returns:        new complete TCSId ( a list of 4 elements)
  264. # Examples:        newId := FillTCSId( oldId );
  265. # Assumptions:    None 
  266. #========================================================================
  267. # History:
  268. #########################################################################
  269. TASK FillTCSId( pTCSId )
  270. begin
  271.     if (TypeOf(pTCSId) <> 'list')
  272.     begin
  273.         println "!!!! Improper TCS Id -- ", pTCSId, " !!!!" ;
  274.         if (TypeOf(pTCSId) = 'integer') #if using old style numeric Id
  275.             return { pTCSId, global kTCSetDefault, global kTCTypeDefault, global kTCOwnerDefault }; 
  276.         else
  277.         return { 0, global kTCSetDefault, global kTCTypeDefault, global kTCOwnerDefault };
  278.     end;
  279.     else #if (TypeOf(pTCSId) = 'list')
  280.     begin
  281.         if (IsUndefined(pTCSId[1]))
  282.             pTCSId := Insert(0, 1, pTCSId);
  283.         else if (TypeOf(pTCSId[1]) <> 'integer')
  284.             pTCSId := replace(0, 1, pTCSId);
  285.     
  286.         if (IsUndefined(pTCSId[2]))
  287.             pTCSId := Insert(global kTCSetDefault, 2, pTCSId);
  288.         else if (TypeOf(pTCSId[2]) <> 'string')
  289.             pTCSId := replace(global kTCSetDefault, 2, pTCSId);
  290.     
  291.         if (IsUndefined(pTCSId[3]))
  292.             pTCSId := Insert(global kTCTypeDefault, 3, pTCSId);
  293.         else if (TypeOf(pTCSId[3]) <> 'string')
  294.             pTCSId := replace(global kTCTypeDefault, 3, pTCSId);
  295.     
  296.         if (IsUndefined(pTCSId[4]))
  297.             pTCSId := Insert(global kTCOwnerDefault, 4, pTCSId);
  298.         else if (TypeOf(pTCSId[4]) <> 'string')
  299.             pTCSId := replace(global kTCOwnerDefault, 4, pTCSId);    
  300.  
  301.         return pTCSId;
  302.     end;
  303. end;
  304.  
  305. #########################################################################
  306. #                            TCSStart(pTCSId, pTextDesc, pAppName)
  307. #========================================================================
  308. # Author:        GS (x25506)
  309. # Description:    Start TCS Record.
  310. # Parameters:    pTCSId -  The TCS Id that results are being recorded for (list)
  311. #                            1st element - Test Case number  (integer)
  312. #                            2nd element - Test Case Set        (string)
  313. #                            3rd element - Test Case Type    (string)
  314. #                            4th element - Test Case Owner    (string)
  315. #                pTextDesc - string that describes the Test Case
  316. #                pAppName - defaults to gAppTitle, otherwise the name of the 
  317. #                            application the Test Case applies to
  318. # Returns:        Nothing
  319. # Examples:        TCSStart();
  320. # Assumptions:    None 
  321. #========================================================================
  322. # History:
  323. # KTA    8/20/93        If TCSAttempted is undefined call InitTCSLogging()
  324. # KTA    12/01/93    Added gTCSStartHook1, and moved ApplicationVerification
  325. #                    so it will be called even if gDBLogging is off
  326. #########################################################################
  327. TASK TCSStart(pTCSId, pTextDesc, pAppName := global gAppTitle)
  328. begin
  329.     if(global gTCSStartHook1)
  330.         Call(gTCSStartHook1);
  331.         
  332.     if (global gDBLogging)
  333.     begin
  334.         global TCSAttempted;
  335.  
  336.         if (IsUndefined(TCSAttempted))
  337.             InitTCSLogging(0);        
  338.         
  339.         TCSAttempted := TCSAttempted + 1;
  340.         pTCSId := FillTCSId( pTCSId );
  341.         if(global gAppIdentifier)
  342.             pAppName := gAppIdentifier;
  343.         if not (pAppName)                    # If AppName is not defined, define it.
  344.             Match[application t:?pAppName];
  345.         TCSBeginTime        := Timer();
  346.         thisTCS               := {pTCSId, pTextDesc, pAppName, TCSBeginTime};
  347.         #println "TCSStart ", pTCSId;
  348.         TCSPush(thisTCS);
  349.     end;
  350.     
  351.     if (global gAppVerify)        # Verify that the correct Application is running
  352.         ApplicationVerification(1);
  353. end;
  354.  
  355. #########################################################################
  356. #                    TopOfTCSStack()
  357. #========================================================================
  358. # Author:        Kevin Avoy (x45604)
  359. # Description:    Returns the top element of TCS stack.
  360. # Parameters:    nothing
  361. #                
  362. # Returns:        thisTCS - TCS from the top of the stack
  363. # Examples:        myTCS := TopOfTCSStack();
  364. # Assumptions:    None 
  365. #========================================================================
  366. # History:
  367. #
  368. #########################################################################
  369. task TopOfTCSStack()
  370. begin
  371.     global gTCSList;
  372.     thisTCSPos    := card(gTCSList);
  373.     thisTCS        := gTCSList[thisTCSPos];
  374.     return(thisTCS);
  375. end;
  376.  
  377. #########################################################################
  378. #                    TCSPop()
  379. #========================================================================
  380. # Author:        Kevin Avoy (x45604)
  381. # Description:    Pops the top element from the stack and returns it.
  382. # Parameters:    nothing
  383. #                
  384. # Returns:        thisTCS - TCS record from the top of the stack
  385. # Examples:        myTCS := TCSPop();
  386. # Assumptions:    None 
  387. #========================================================================
  388. # History:
  389. #
  390. #########################################################################
  391. task TCSPop()
  392. begin
  393.     global gTCSList;
  394.     thisTCSPos    := card(gTCSList);
  395.     thisTCS        := gTCSList[thisTCSPos];
  396.     gTCSList := remove(thisTCSPos, gTCSList); #decrement the stack
  397.     #println gTCSList;
  398.     return(thisTCS);
  399. end;
  400.  
  401. #########################################################################
  402. #                    TCSPush(pThisTCS)
  403. #========================================================================
  404. # Author:        Kevin Avoy (x45604)
  405. # Description:    Push <pThisTCS> onto the stack
  406. # Parameters:    pThisTCS - TCS record to push onto the stack
  407. #                
  408. # Returns:        Nothing
  409. # Examples:        TCSPush(myTCS);
  410. # Assumptions:    None 
  411. #========================================================================
  412. # History:
  413. #
  414. #########################################################################
  415. task TCSPush(pThisTCS)
  416. begin
  417.     global gTCSList;
  418.     
  419.     thisTCSPos            := card(gTCSList) + 1;
  420.     gTCSList            := insert(pThisTCS, thisTCSPos, gTCSList); #add thisTCS to the end of the stack
  421.     if(global gDebugFlag)
  422.         println"TCSPush ",gTCSList;
  423. end;
  424.  
  425. #########################################################################
  426. #        TCSEnd(pTCSId,pResultCode, pErrStr, pTCSVal, pTCSStr, pResultStr, pExceptionFlag)
  427. #========================================================================
  428. # Author:        GS (x25506)
  429. # Description:    This task is called when the functionality of the pending TCS 
  430. #                is complete.  It will pop the top TCS record from the TCS stack,
  431. #                check to insure the TCS numbers match.  If the result code (<pResultCode>)
  432. #                is 0 a check will be done to insure no unexpected dialogs are present.
  433. #                A call to ExceptionHandler() is made to insure that no VU errors were 
  434. #                encountered. Then the appropriate output task is called to output the 
  435. #                data.  
  436. # Parameters:    pTCSId -  The TCS Id that results are being recorded for (list)
  437. #                            1st element - Test Case number  (integer)
  438. #                            2nd element - Test Case Set        (string)
  439. #                            3rd element - Test Case Type    (string)
  440. #                            4th element - Test Case Owner    (string)
  441. #                pResultCode - The result of the TCS on top of Stack (Lifo)
  442. #                pErrStr - Reason for failure if known.
  443. #                pTCSVal - Any value a TCS needs to return for additional info.
  444. #                pTCSStr - Any string a TCS needs to return for additional info.
  445. #                pResultStr - A string the TCS can return results in.
  446. #                pExceptionFlag     - incase of critical error we may need to dump the stack
  447. #                                - 'NoRecursion' this will avoid recursion 
  448. #                                - any integer will bail the suite with the value of the integer    
  449. # Returns:        Nothing
  450. # Examples:        TCSEnd();
  451. # Assumptions:    None 
  452. #========================================================================
  453. # History:
  454. # KTA    7/6/93        If not gDBLogging TCSEnd will not do anything
  455. # KTA    7/20/93        Failreason was being reinitialized thus destroying any parameter data.
  456. # KTA    7/28/93        Added gTCSEndHook1 and reworked dialogHandler
  457. # KTA    8/05/93        Support for new Pheonix data format
  458. # KTA    8/09/93        Added pDumpStack parameter
  459. # KTA    8/24/93        TCS stack parity check
  460. # KTA    12/01/93    moved gTCSEndHook1 so it will be called even if gDBLogging is off.
  461. # KTA    12/1/93        Not writing total TestCase info to notebooks.
  462. # KTA    12/13/93    Changed parameter pDumpStack to pExceptionFlag
  463. #########################################################################
  464. TASK TCSEnd(pTCSId := {}, pResultCode := '', pErrStr := '', pTCSVal := 0, pTCSStr := '', pResultStr := '', pExceptionFlag := '')
  465. begin
  466.     if(global gTCSEndHook1)
  467.         Call (gTCSEndHook1, TopOfTCSStack());
  468.         
  469.     if (global gDBLogging)
  470.     begin
  471.         eTCSTime := 0;
  472.         
  473.         rightNow := Timer();                        # Current Time
  474.         thisTCS := TCSPop();                        # Pop the current TCS    
  475.         #### TCS Parity check - are we working with the right TCS???
  476.         StackTCSId := thisTCS[1];
  477.         if (StackTCSId[1] <> pTCSId[1]) or (StackTCSId[2] <> pTCSId[2])
  478.         begin
  479.             println "    TCS mismatched : TOS -  ", StackTCSId, ", Passed in - ", pTCSId;
  480.             println "    Exiting Script - the TCS stack is unbalanced";
  481.             call (global gExitVU);
  482.         end;
  483.         
  484.         eTCSTime := ETime(thisTCS[4], rightNow);    # Elapsed Time
  485.  
  486.         if not(pExceptionFlag = 'NoRecursion') and (global gExceptionHandler)        # Insure that we are not calling recursively
  487.             call (gExceptionHandler,, eTCSTime, pErrStr);
  488.  
  489.         if (typeOf(pResultCode) = 'string')    # if embedded task returns string, i.e. selectmenuitem
  490.             pResultCode:=1;                    # set pResultCode to success
  491.  
  492.         if (pResultCode = 0) and not(pExceptionFlag = 'NoRecursion')     # do we to dialogCheck for pResultCode < 0
  493.         begin
  494.             for i := 1 to 6
  495.             begin
  496.                 myErrStr :=    DialogHandler();
  497.                 if(TypeOf(myErrStr) = 'string')
  498.                     pErrStr   := pErrStr + myErrStr;
  499.                 else if(myErrStr = -1)
  500.                     i := 7;
  501.  
  502.                 if(i = 6)
  503.                 begin
  504.                     pErrStr := "Failed in infinite dialog check - {pErrStr}";
  505.                     pExceptionFlag := 0;    # Abort suite fail with a 0
  506.                 end;
  507.             end;
  508.         end;
  509.         else if (pResultCode < 0)        # QuickStats
  510.             global TCSNotAvail := TCSNotAvail + 1;
  511.         else if (pResultCode > 0)
  512.             global TCSPassed := TCSPassed + 1;
  513.                         
  514.         if(global gDebugFlag)
  515.             println"TCSend ",gTCSList;
  516.             
  517.         ### Output database records to the NoteBook
  518.         if(global gNoteBookOutput)            
  519.             PrintTCSRecord(thisTCS, pResultCode,  pResultStr, pTCSVal, pTCSStr, pErrStr, eTCSTime);
  520.         
  521.         ### Output database records using FileTool
  522.         if(global gTestCaseLoggingMethod = 1)    
  523.             LogTCSRecord(thisTCS, pResultCode,  pResultStr, pTCSVal, pTCSStr, pErrStr, eTCSTime);
  524.             
  525.         if (not(pExceptionFlag = 'NoRecursion') and not(pExceptionFlag = ''))    # Fatal Error
  526.             CleanAbort(pErrStr,,pExceptionFlag);
  527.  
  528.     end;
  529. end;  # TCSEnd()
  530.  
  531.  
  532. #########################################################################
  533. #            ExceptionHandler(pTheError := 0, pElaspedTCSTime, pFailReason)
  534. #========================================================================
  535. # Author:        GS (x25506)
  536. # Description:    Handle Exceptions. It currently handlessome VU errors and 
  537. #                some TCS related errors.  (This will change).  If a fatal
  538. #                error occured CleanAbort() will be called to dumped the
  539. #                TCS Stack and exit the script
  540. # Parameters:    pTheError - Error code if its a TCS related error.  If this 
  541. #                        evaluates to 0 it will be reset with a call to ScriptError()
  542. #                pElaspedTCSTime - The elapsed time it took to complete the pending
  543. #                                TCS.
  544. #                pFailReason - A reason for calling ExceptionHandler() if known,
  545. #                            (normally TCS related errors if this is defined).
  546. # Returns:        Nothing
  547. # Examples:        ExceptionHandler();
  548. # Assumptions:    None 
  549. #========================================================================
  550. # History:
  551. #
  552. #########################################################################
  553. task ExceptionHandler(pTheError := 0, pElaspedTCSTime := 0, pFailReason := "")
  554. begin
  555.     suitCompletion := 0;
  556.     if (global gExHandling)
  557.     begin
  558.         if (pTheError = 0)
  559.         begin 
  560.             tempTimeOut := NetworkTimeout(10);
  561.             tempRetries := NetworkRetries(2);
  562.             
  563.             match[target a:?dummyVar s:?dummyVar2];
  564.             pTheError := scriptError();
  565.             
  566.             NetworkTimeout(tempTimeOut);
  567.             NetworkRetries(tempRetries);            
  568.         end;
  569.         
  570.         if(gDebugFlag)
  571.             println "ScriptError: ",pTheError;
  572.     
  573.         if not(pTheError)
  574.             return(0);
  575.                     
  576.             theFailReason := "Unaccounted Error " + "{pTheError}";
  577.         if (pTheError =  -1100)
  578.         begin
  579.             println "!!!!!!  Target Failure  (ScriptError = -1100)  !!!!!!!";
  580.             theFailReason := "Target Failure  (ScriptError = -1100)";
  581.             suitCompletion := -2;        
  582.         end;
  583.  
  584.         else if (pTheError = -1)
  585.         begin
  586.             println "!!!!!!  Unknown VU Error (ScriptError = -1)   !!!!!!!";
  587.             theFailReason := "Unknown VU Error (ScriptError = -1)";
  588.         end;
  589.             
  590.         else if (pTheError  = -2)
  591.         begin
  592.             println "!!!!!!  VU Program Error (ScriptError = -2)   !!!!!!!";
  593.             theFailReason := "VU Program Error (ScriptError = -2)";
  594.         end;
  595.         
  596.         else if (pTheError = -69)
  597.         begin
  598.             println "!!!!!! We're off track  !!!!!!!";
  599.             theFailReason := "We're off track (ScriptError = -69)";
  600.         end;
  601.                 
  602.         theFailReason := pFailReason + " *" + theFailReason;
  603.     
  604.         CleanAbort(theFailReason, pElaspedTCSTime, suitCompletion);
  605.     end;
  606. end;
  607.  
  608.  
  609. #########################################################################
  610. #        CleanAbort(pFailReason, pElapsedTCSTime := 0, pSuiteComplete := 0)
  611. #========================================================================
  612. # Author:        GS (x25506)
  613. # Description:    Dumps the TCS stack appropriately failing the TCS's that 
  614. #                couldn't be completed. Then releases the target, and exits 
  615. #                the script
  616. # Parameters:    pFailReason - Reason for failing TCS.
  617. #                pElapsedTCSTime - Time it took for TCS to complete
  618. #                pSuiteComplete - Completion Code for Suite.
  619. # Returns:        Nothing
  620. # Examples:        CleanAbort();
  621. # Assumptions:    None 
  622. #========================================================================
  623. # History:
  624. # KTA 9/1/93    Updated so only the TCS record at the top of the stack will
  625. #                fail with a 0, all others fail with -1 (expected fail)
  626. # KTA 12/13/93    Moved functionality of clearing the stack to it's own task - ClearStack().
  627. #########################################################################
  628. task CleanAbort(pAbortReason := '', pElapsedTCSTime := 0, pSuiteComplete := 0)
  629. begin        
  630.     println "Aborting Script";
  631.     
  632.     ClearStack(pAbortReason);
  633.     
  634.     println "Releasing Target!!";
  635.     releaseTarget();
  636.     
  637.     SuiteEnd(pSuiteComplete);
  638.     
  639.     call (global gExitVU);
  640. end;
  641.  
  642. #########################################################################
  643. #                    ClearStack(pFailReason)
  644. #========================================================================
  645. # Author:        Kevin Avoy (x4-5604)
  646. # Description:    Pops all of the TCSes from the TCS stack appropriately failing
  647. #                them with an error code of -1 
  648. # Parameters:    pFailReason - Reason for failing TCS that is at the top of the stack.
  649. # Returns:        Nothing
  650. # Examples:        ClearStack('I wanted to');
  651. # Assumptions:    None 
  652. #========================================================================
  653. # History:
  654. # KTA 12/13/93    Created
  655. #########################################################################
  656. TASK ClearStack(pAbortReason := '')
  657. begin
  658.     count := 0;
  659.     for each item in global gTCSList
  660.     begin
  661.         count         := count + 1;
  662.         thisTCS        := gTCSList[count];
  663.         TCSNum := thisTCS[1];
  664.         if (count = 1)        # The current fail reason should only belong to the top of the stack
  665.             failReason  :=  pAbortReason;
  666.         else 
  667.             failReason  := "The previous TCS created a critical failure";
  668.         
  669.         TCSEnd(TCSNum, -1, failReason,,,,'NoRecursion');
  670.     end;
  671. end;
  672.  
  673. #########################################################################
  674. #                SuiteStart(pScriptName, pScriptParamList, pScriptVersion)
  675. #========================================================================
  676. # Author:        GS (x25506)
  677. # Description:    Start Suite Record.
  678. # Parameters:    pScriptName - Name of the current script 
  679. #                pScriptParamList - list of VU parameters for the current execution
  680. #                pScriptVersion - version of the current script
  681. # Returns:        Nothing
  682. # Examples:        SuiteStart("MacDraw.vu", {1}, '1.1.2');
  683. # Assumptions:    None 
  684. #========================================================================
  685. # History:
  686. # KTA    8/5/93    Rewrote calling PrintSuiteHeader
  687. # KTA    8/9/93    Added ability to output DB Records to Notebook and/or with FileTool
  688. # KTA    9/2/93    Not writing to string 'FileTool output' to prefs file anymore.
  689. # KTA    12/1/93    Not writing to any suite info to notebooks.
  690. #########################################################################
  691. TASK SuiteStart(pScriptName := '', pScriptParamList := {}, pScriptVersion := 'xxx')
  692. begin
  693.     global gAppTitleSaveOff := global gAppTitle;        # Used in SuiteEnd() for lab report
  694.     global gSuiteStarted := 1;                    # Indicates the suite was started/used in SuiteEnd
  695.     if (global gDBLogging)
  696.     begin        
  697.         InitTCSLogging(global gTestCaseLoggingMethod);        # Initialize all globals and <Constants>
  698.         
  699.         ### Output database records using FileTool
  700.         if(global gTestCaseLoggingMethod = 1)            
  701.         begin
  702.             LogStr( "TCS Records will be written to the file - '{global gFileToolOutputFile}'");
  703.             LogSuiteHeader(pScriptName, pScriptVersion, "{pScriptParamList}");
  704.             myreturn := WriteToFile(global gFileToolOutputTempFile, "        TEST CASE    [∂n");
  705.             if (myReturn[1] <> 0)    # we cannot write to our file 
  706.                 println "WARNING: Problem writing to output file using FileTool, TCSOutput is not being written";
  707.         end;
  708.         else
  709.             LogStr( "TCS Records are not being written with the FileTool");
  710.             
  711.         global gFirstTCS := true;
  712.     end;
  713.     BeginTimer();
  714. end;
  715.  
  716.  
  717. #########################################################################
  718. #                            SuiteEnd(pCompletionCode)
  719. #========================================================================
  720. # Author:        GS (x25506)
  721. # Description:    End Suite Record. 
  722. # Parameters:    pCompletionCode - Code which indicates success of suite 
  723. #                                1 - Completed successfully
  724. #                                0 - Completed unsuccessfully
  725. # Returns:        Nothing
  726. # Examples:        SuiteEnd(1);
  727. # Assumptions:    none 
  728. # Additional information concerning global gSuiteFooterHook:
  729. #     gSuiteFooterHook has been provided to allow additonal information to be written
  730. #     to the suite block.  If there is additonal information that needs to be written to
  731. #    the suite block, gSuiteFooterHook needs to be defined as a task reference that
  732. #    returns a formatted string. The string should be defined as 1 or more Phoenix data fields.
  733. #    Each new field should be in the form of "∂t∂t<FieldLabel>:∂t<FieldData>∂n"
  734. #     If there are multiple fields that need to be returned, they should be
  735. #     concatenated and returned as a single string. Note: the default setting is that
  736. #    gSuiteFooterHook is undefined and thus nothing will be added to the suite footer
  737. #    unless explicitly defined.
  738. #========================================================================
  739. # History:
  740. # KTA    7/13/93        Added TCSExpCount as per Gil
  741. # KTA    8/4/93        support for new Pheonix data format
  742. # KTA    12/1/93        Not writing to any suite info to notebooks.
  743. # KTA    12/2/93        Added gSuiteFooterHook.
  744. #########################################################################
  745. TASK SuiteEnd(pCompletionCode := 1)
  746. begin
  747.     if(global gSuiteStarted) # Suite was started. 
  748.     begin                     # Indicates that SuiteStart was called
  749.         if(pCompletionCode = 1)
  750.             Endtimer();
  751.     
  752.         if (global gDBLogging)
  753.         begin
  754.             tab   := "∂t";
  755.             AdditionalSuiteInfo := '';
  756.             
  757.             global TCSAttempted, TCSPassed,gAppTitleSaveOff,TCSNotAvail, TCSExpCount;
  758.             
  759.             suiteEndTime   := GetCurrentTime(1,0);
  760.             
  761.             match[time d:?day m:?month y:?year];
  762.             suiteEndDate   := "{month}/{day}/{year}";
  763.                         
  764.             ### Output database records using FileTool
  765.             if(global gTestCaseLoggingMethod = 1)            
  766.             begin
  767.                 TCSTrailerString     := "        ]∂n";                                # TCSTrailer
  768.                 EndDateString         := "        EndDate:    {suiteEndDate}∂n";
  769.                 EndTimeString         := "        EndTime:    {suiteEndTime}∂n";
  770.                 SuiteValString        := "        SuiteVal:    {pCompletionCode}∂n";
  771.                 
  772.                 if (global gSuiteFooterHook)                                # Hook to add info to the suite footer (see task header for more details.)
  773.                     AdditionalSuiteInfo := Call (gSuiteFooterHook);            
  774.  
  775.                 SuiteTrailerString     := "    &&∂n";                            # SuiteTrailer
  776.                 theString := TCSTrailerString + EndDateString + EndTimeString + SuiteValString + AdditionalSuiteInfo + SuiteTrailerString;
  777.                 WriteToFile(global gFileToolOutputTempFile, theString);
  778.                 
  779.                 AppendData := AppendFile( global gFileToolOutputFile, gFileToolOutputTempFile);
  780.                 if(AppendData[1] <>0)
  781.                 begin
  782.                     println "Sorry, error appending to main file - global gFileToolOutputFile";
  783.                     Println "Error := ", AppendData[1], AppendData[3];
  784.                 end;
  785.                 else
  786.                     DeleteFile( gFileToolOutputTempFile    ); # Clean Up - delete the temp files            
  787.             end;
  788.             # This is for MatrixCheck - QuickStats
  789.             println "¬ ",gAppTitleSaveOff, tab, TCSExpCount, tab, TCSPassed, tab, TCSAttempted, tab, TCSNotAvail, tab, pCompletionCode, tab, tab, suiteEndDate, tab, SuiteEndTime;
  790.         end;
  791.     end; # The suite was never started
  792. end;
  793.  
  794. #########################################################################
  795. #                ApplicationVerification(pAppVerify)
  796. #========================================================================
  797. # Author:        Kevin Avoy (x45604)
  798. # Description:    Verify that the current Application is the same as the global
  799. #                gAppTitle.  If not successfull, Abort of script will occur thru
  800. #                ExceptionHandler().
  801. # Parameters:    pAppVerify - 1 := will make the check
  802. #                            0 := will not make the check
  803. # Returns:        nothing
  804. # Examples:        ApplicationVerification(1);
  805. # Assumptions:    None 
  806. #========================================================================
  807. # History:
  808. # KTA    9/14/93    If gAppTitle is not defined turn off Application Verification
  809. # KTA    9/20/93    Retry counter was decremented and it should have been incremented
  810. # KTA    9/22/93    theAppTitle was undefined
  811. # KTA    12/06/93    if gApptitle =  'Unknown' turn off gAppVerify
  812. #########################################################################
  813. task ApplicationVerification(pAppVerify := 0)
  814. begin
  815.     if (pAppVerify) and (Global gAppVerify)
  816.     begin
  817.         if not(global gAppTitle) or (gApptitle =  'Unknown')
  818.         begin
  819.             LogStr("The global 'gAppTitle' was not defined turning OFF the Application Verfication scheme");
  820.             global gAppVerify := 0;
  821.         end;
  822.         else
  823.         begin
  824.             retry := 0;
  825.             while not( match[application t:gAppTitle])     # assume target crashed if app name not match
  826.             begin
  827.                 if(global gExceptionHandler)
  828.                     call (gExceptionHandler,,,"LogStr couldn't match target");
  829.                 if (retry < 2)
  830.                 begin
  831.                     if (match[menuitem t:gAppTitle m:[menu t:?Menutitle]])
  832.                     begin
  833.                         Select[MenuItem t:gAppTitle m:[menu t:Menutitle]];
  834.                         wait(3);
  835.                     end;
  836.                     retry := retry + 1;
  837.                 end;
  838.                 else 
  839.                 begin
  840.                     match[application t:?theAppTitle];
  841.                     PressKey K:{CommandKey};
  842.                     Type k: {'q'};        # Quit
  843.                     ReleaseKey K:{CommandKey};
  844.                     Println "*** Failed Application Verification - aborting script and typing key Equivalent 'Q'";
  845.                     Println;
  846.                     CleanAbort("Failed app verification scheme - *** Current app: '{theAppTitle}'   *** Expected app: '{gAppTitle}'");
  847.                 end;
  848.             end;
  849.         end;
  850.     end;
  851. end; # ApplicationVerification()
  852.  
  853.  
  854. #########################################################################
  855. #        PrintTCSRecord(pTCSRecord, pResultCode, pResultStr, pTCSVal, pTCSStr, pErrStr, pElapsedTime)
  856. #========================================================================
  857. # Author:        Kevin Avoy (x4-5604)
  858. # Description:    Prints TCS record information to the notebook.
  859. # Parameters:    pTCSRecord - The current TCS Record from top of stack
  860. #                pResultCode - Result of the TCS
  861. #                pResultStr - String provided for returning results
  862. #                pTCSVal - field for TCS specific values
  863. #                pTCSStr - field for TCS specific strings
  864. #                pErrStr - String for explaining failure
  865. #                pElapsedTime -  Elapsed time
  866. # Returns:        Nothing
  867. # Examples:        PrintTCSRecord();
  868. # Assumptions:    None 
  869. #========================================================================
  870. # History:
  871. # KTA    8/09/93     Added check to see if field exist before printing it.
  872. # KTA    9/30/93     Fixed a bug where pTCSVal wouldn't print if is was an integer
  873. # KTA    9/30/93     Print all fields for gNoteBookOutput = 2 if they exist
  874. # KTA    12/01/93 Con no longer print complete Test Case output to notebooks
  875. #########################################################################
  876. task PrintTCSRecord(pTCSRecord, pResultCode, pResultStr, pTCSVal, pTCSStr, pErrStr, pElapsedTime)
  877. begin
  878.     if (gNoteBookOutput)
  879.     begin
  880.         Print "        •TCS - ", pTCSRecord[1], ",  ",pTCSRecord[2], ",  ", pResultCode;
  881.         if(pResultStr)
  882.             print ", ", pResultStr;
  883.         if(pTCSVal)
  884.             print ", ", pTCSVal;
  885.         if(pTCSStr)
  886.             print ", ", pTCSStr;
  887.         if(pErrStr)
  888.             print ", ", pErrStr;
  889.             
  890.         println;
  891.     end;
  892. end;
  893.  
  894. #########################################################################
  895. #        LogSuiteHeader(pScriptName, pScriptVersion, pScriptParameterList)
  896. #========================================================================
  897. # Author:        Kevin Avoy (x4-5604)
  898. # Description:    Outputs suite header information utilizing the FileTool 
  899. # Parameters:    pScriptName - Name of the current script
  900. #                pScriptVersion - Version of the current script
  901. #                pScriptParameterList - Parameters to the current script
  902. # Returns:        Nothing
  903. # Examples:        LogSuiteHeader("MacDraw", '1.0',{1});
  904. # Assumptions:    None 
  905. #========================================================================
  906. # History:
  907. # KTA    9/23/93    Commented out Desc field as we can't get any useful info for this field yet.
  908. #########################################################################
  909. task LogSuiteHeader( pScriptName := 'na', pScriptVersion := 'na', pScriptParameterList := "")
  910. begin
  911.     global gAppTitle, gAppVersion, gSeedValue;
  912.     SuiteHeaderString := "∂n∂n";
  913.     
  914.  
  915.     theMachineState := MachineState();
  916.     TargetName := assoc('TargetName', theMachineState);
  917.         TargetNameString := "        TargetName:        {TargetName}∂n";                        # TargetName
  918.             SuiteHeaderString := SuiteHeaderString + TargetNameString;
  919.             
  920.     if not(gAppTitle)
  921.         gAppTitle := 'Unknown';
  922.     AppNameString     := "        AppName:        {gAppTitle}∂n";                            # AppName
  923.         SuiteHeaderString := SuiteHeaderString + AppNameString;
  924.     
  925.     if(gAppVersion)
  926.     begin
  927.         AppVersionString := "        AppVers:        {gAppVersion}∂n";                        # AppVersion
  928.             SuiteHeaderString := SuiteHeaderString + AppVersionString;
  929.     end;
  930.     
  931.     SuiteNameString := "        SuiteName:        {pScriptName}∂n";                        # ScriptName
  932.         SuiteHeaderString := SuiteHeaderString + SuiteNameString;
  933.     
  934.     SuiteVersionString := "        SuiteVers:        {pScriptVersion}∂n";                    # ScriptVersion
  935.         SuiteHeaderString := SuiteHeaderString + SuiteVersionString;
  936.     
  937.     match[time d:?day m:?month y:?year];
  938.     suiteStartDate   :=  "{month}/{day}/{year}";        
  939.     StartDateString := "        StartDate:        {SuiteStartDate}∂n";                    # SuiteStartDate
  940.         SuiteHeaderString := SuiteHeaderString + StartDateString;
  941.     
  942.     suiteStartTime := GetCurrentTime(1,0);
  943.     StartTimeString := "        StartTime:        {SuiteStartTime}∂n";                    # SuiteStartTime
  944.         SuiteHeaderString := SuiteHeaderString + StartTimeString;
  945.         
  946.     #DescString := "        Desc:                We don't know∂n";                                # Desc
  947.         #SuiteHeaderString := SuiteHeaderString + DescString;
  948.  
  949.     SeedValueString := "        SeedValue:        {gSeedValue}∂n";                        # SeedValue
  950.         SuiteHeaderString := SuiteHeaderString + SeedValueString;
  951.     
  952.     # Now write it off to file (since VU strings can't be longer than 2000 chars)
  953.     WrittenFile := WriteToFile(global gFileToolOutputTempFile, SuiteHeaderString);
  954.     If(WrittenFile[1] <> 0)
  955.     begin
  956.         Println "!@#$% An error occured while writing the file";
  957.         Println "Error", WrittenFile[1], WrittenFile[3];
  958.         global gTestCaseLoggingMethod := 0;        # Turn FileTool output - OFF
  959.     end;
  960.     SuiteHeaderString := ""; # re-initialize to null
  961.     
  962.     drawMethod        :=  "gDrawLevel := {global gDrawLevel}; ";
  963.     WindowMethod    :=  "gWindowLevel := {global gWindowLevel}; ";
  964.     FontMethod        :=  "gFontLevel := {global gFontLevel};";
  965.     globList         :=     drawMethod + WindowMethod + FontMethod;
  966.     ScriptParamsString     :=  "        SuiteParams:    {pScriptParameterList}; {globList}∂n";# ScriptParameterList & Globals
  967.         SuiteHeaderString := SuiteHeaderString + ScriptParamsString;
  968.  
  969.     AddrMode := assoc('AddrMode', theMachineState);
  970.         AddrModeString := "        AdMode32:        {AddrMode}∂n";                            # AddrMode
  971.             SuiteHeaderString := SuiteHeaderString + AddrModeString;
  972.             
  973.     LogicalMem := assoc('LogicalMem', theMachineState);
  974.         LogicalMemString := "        LogicalMem:        {LogicalMem}∂n";                    # LogicalMem
  975.             SuiteHeaderString := SuiteHeaderString + LogicalMemString;
  976.             
  977.     PhysicalMem := assoc('PhysicalMem', theMachineState);
  978.         PhysicalMemString := "        PhysicalMem:    {PhysicalMem}∂n";                    # PhysicalMem
  979.             SuiteHeaderString := SuiteHeaderString + PhysicalMemString;
  980.             
  981.     VM := assoc('VM', theMachineState);
  982.         VMString := "        VM:                {VM}∂n";                                    # VM
  983.             SuiteHeaderString := SuiteHeaderString + VMString;
  984.             
  985.     FileSharing := assoc('FileShare', theMachineState);
  986.         FileSharingString := "        FileShare:        {FileSharing}∂n";                    # FileSharing
  987.             SuiteHeaderString := SuiteHeaderString + FileSharingString;
  988.  
  989.     caches := assoc('cache', theMachineState);
  990.         CacheString := "        Cache:            {caches}∂n";                            # cache
  991.             SuiteHeaderString := SuiteHeaderString + CacheString;
  992.  
  993.     SystemArchitecture := assoc('SystemArch', theMachineState);
  994.         SystemArchitectureString := "        SystemArch:        {SystemArchitecture}∂n";
  995.             SuiteHeaderString := SuiteHeaderString + SystemArchitectureString;            # SystemArchitecture
  996.  
  997.     SuiteHeaderString := SuiteHeaderString + "∂n" ;
  998.     WrittenFile := WriteToFile(global gFileToolOutputTempFile, SuiteHeaderString);
  999.     If(WrittenFile[1] <> 0)
  1000.     begin
  1001.         Println "!@#$% An error occured while writing the file";
  1002.         Println "Error", WrittenFile[1], WrittenFile[3];
  1003.         global gTestCaseLoggingMethod := 0;        # Turn FileTool output - OFF
  1004.     end;
  1005. end;
  1006.  
  1007. #########################################################################
  1008. #    LogTCSRecord(pTCSRecord, pResultCode, pResultStr, pTCSVal, pTCSStr, pErrStr, pElapsedTime)
  1009. #========================================================================
  1010. # Author:        Kevin Avoy (x4-5604)
  1011. # Description:    Outputs TCS records utilizing the FileTool.
  1012. # Parameters:    pTCSRecord - The current TCS Record from top of stack
  1013. #                pResultCode - Result of the TCS
  1014. #                pResultStr - String provided for returning results
  1015. #                pTCSVal - field for TCS specific values
  1016. #                pTCSStr - field for TCS specific strings
  1017. #                pErrStr - String for explaining failure
  1018. #                pElapsedTime -  Elapsed time
  1019. # Returns:        Nothing
  1020. # Examples:        LogTCSRecord(thisTCS,1);
  1021. # Assumptions:    None 
  1022. #========================================================================
  1023. # History:
  1024. # KTA    9/14/93    If trouble with Filetool turn off fileToolOutput
  1025. #########################################################################
  1026. task LogTCSRecord(pTCSRecord, pResultCode, pResultStr, pTCSVal, pTCSStr, pErrStr, pElapsedTime)
  1027. begin    
  1028.     TCSString := '';
  1029.     global gFirstTCS;
  1030.     if not(gFirstTCS)
  1031.         TCSString:= TCSString + "        &&∂n";
  1032.     else
  1033.         gFirstTCS := false;
  1034.  
  1035.  
  1036.     thisTCSNo := pTCSRecord[1][1];
  1037.     thisTCSSet := pTCSRecord[1][2];
  1038.     thisTCSType := pTCSRecord[1][3];
  1039.     thisTCSOwner := pTCSRecord[1][4];
  1040.     thisTCSDesc := pTCSRecord[2]; 
  1041.     TCSString         :=  TCSString + "            TCNo:            {thisTCSNo}∂n";
  1042.     TCSString         :=  TCSString + "            TCSet:            {thisTCSSet}∂n";
  1043.     TCSString         :=  TCSString + "            TCType:            {thisTCSType}∂n";
  1044.     TCSString         :=  TCSString + "            TCOwner:        {thisTCSOwner}∂n";
  1045.         
  1046.     TCSDescrString         := "            TCDesc:            {thisTCSDesc}∂n";
  1047.         TCSString         := TCSString + TCSDescrString;
  1048.  
  1049.     ResultCodeString     :=  "            Result:            {pResultCode}∂n";
  1050.         TCSString         := TCSString + ResultCodeString;
  1051.         
  1052.     if (pResultStr)
  1053.     begin
  1054.         ResultStrString :=  "            ResultDesc:        {pResultStr}∂n";
  1055.         TCSString         := TCSString + ResultStrString;
  1056.     end;
  1057.     if (pTCSVal)
  1058.     begin
  1059.         TCSValString     :=  "            NumericVal:        {pTCSVal}∂n";
  1060.         TCSString         := TCSString + TCSValString;
  1061.     end;
  1062.     if (pTCSStr)
  1063.     begin
  1064.         TCSStrString     :=  "            TextVal:        {pTCSStr}∂n";
  1065.         TCSString         := TCSString + TCSStrString;
  1066.     end;
  1067.     if (pErrStr)
  1068.     begin
  1069.         ErrStrString     :=  "            ErrDesc:        {pErrStr}∂n";
  1070.         TCSString         := TCSString + ErrStrString;
  1071.     end;
  1072.     if (pElapsedTime)
  1073.     begin
  1074.         elapsedTime     :=  "            ElapsedTime:    {pElapsedTime}∂n";
  1075.         TCSString         := TCSString + elapsedTime;
  1076.     end;
  1077.     WrittenFile := WriteToFile(global gFileToolOutputTempFile, TCSString);
  1078.     If(WrittenFile[1] <> 0)
  1079.     begin
  1080.         Println "!@#$% An error occured while writing to the file {gFileToolOutputTempFile}";
  1081.         Println "Error", WrittenFile[1], WrittenFile[3];
  1082.         global gTestCaseLoggingMethod := 0;        # Turn FileTool output - OFF
  1083.     end;
  1084.     else if(WrittenFile = -50)
  1085.     begin
  1086.         Println "!@#$% An error occured while writing to the TCS Output file";
  1087.         Println "TCS Records will not be written - SuiteStart() was not called prior to making TCS calls";
  1088.         global gTestCaseLoggingMethod := 0;        # Turn FileTool output - OFF
  1089.     end;
  1090. end;
  1091.